home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 10 / FM Towns Free Software Collection 10.iso / fb386 / tool / watanabe / mouse / mouse.bas < prev    next >
BASIC Source File  |  1995-01-19  |  14KB  |  374 lines
  1. 1000 '********************************************************************
  2. 1010 '*                プログラム開発支援シリーズ第１弾                  *
  3. 1020 '*                                                                  *
  4. 1030 '*             マウスカーソル編集プログラム  Ver 2.55               *
  5. 1040 '*                               1995年１月14日(土)   by 渡辺 良一  *
  6. 1050 '********************************************************************
  7. 1060   CLEAR ,,1024,200000,6,0:STOP OFF
  8. 1070   DEF FONT"システム   16ﾄﾞｯﾄ"
  9. 1080   DEFINT A-Z,取
  10. 1090   LOADM"keyclear.rex",0
  11. 1100   DIM M(1,31,31),MC(1,31,31),A(1,31,31),PA(63),PD(63)
  12. 1110   EX=561:EY=9:CL=0
  13. 1120   A&=VARPTR(PA(0)):D&=VARPTR(PD(0))
  14. 1130 'マウス初期パターン読み込み
  15. 1140   OPEN"I",#1,"mouse.dot"
  16. 1150   FOR D=0 TO 1
  17. 1160   FOR Y=0 TO D*16+15
  18. 1170     FOR I=0 TO D*16+14 STEP 4
  19. 1180       V=ASC(INPUT$(1,1)):W=64
  20. 1190       FOR X=0 TO 3
  21. 1200         MC(D,X+I,Y)=V \ W
  22. 1210         V=V-MC(D,X+I,Y)*W
  23. 1220         W=W/4
  24. 1230   NEXT X,I,Y,D
  25. 1240   CLOSE #1
  26. 1250 '********* 画面初期化 ****************************
  27. 1260   SCREEN 0:SCREEN@0
  28. 1270   WINDOW(0,0)-(1023,511)
  29. 1280   VIEW  (0,0)-(1023,511)
  30. 1290   PALETTE 0 ,[0,0,0]       '黒
  31. 1300   PALETTE 9 ,[0,0,255]     '青
  32. 1310   PALETTE 10,[0,255,0]     '赤
  33. 1320   PALETTE 12,[255,0,0]     '緑
  34. 1330   PALETTE 13,[128,128,128] '灰
  35. 1340   PALETTE 14,[180,150,200] '黄緑
  36. 1350   PALETTE 15,[255,255,255] '白
  37. 1360 '******* 編集場所表示 **************************
  38. 1370 *画面表示
  39. 1380   ON ERROR GOTO 0
  40. 1390   ER=0:COLOR 1,1,1,0:CLS
  41. 1400   FOR D=16 TO 32 STEP 16
  42. 1410     IF D=16 THEN XX=350 ELSE XX=0
  43. 1420     LINE(XX,0)-STEP(D*10,D*10),PSET,4,BF,4
  44. 1430    FOR X=0 TO D
  45. 1440       IF X AND 15 THEN C=6:M=1 ELSE C=2:M=0
  46. 1450       LINE(XX+X*10,M)-STEP(0,D*10-M*2),PSET,C
  47. 1460     NEXT
  48. 1470     FOR Y=0 TO D
  49. 1480       IF Y AND 15 THEN C=6:M=1 ELSE C=2:M=0
  50. 1490       LINE(XX+M,Y*10)-STEP(D*10-M*2,0),PSET,C
  51. 1500   NEXT Y,D
  52. 1510 '******* コマンド表示 ************************
  53. 1520   RESTORE
  54. 1530   FOR Y=EY TO EY+133 STEP 19
  55. 1540     READ C$,C
  56. 1550     LINE(EX,Y)-STEP(50,19),PSET,0,BF,5
  57. 1560     SYMBOL(EX+3,Y+2),C$,1,1,7
  58. 1570     IF C<>8 THEN LINE(EX+34,Y)-STEP(16,19),PSET,0,BF,C
  59. 1580   NEXT
  60. 1590   C0=1:GOSUB *C_C
  61. 1600 '******* 実物表示 *****************************
  62. 1610   ZX=350:ZY=200
  63. 1620   LINE(ZX,ZY)      -STEP(100,40),PSET,0,BF,5
  64. 1630   LINE(ZX,ZY+20)   -STEP(100,0) ,PSET,0
  65. 1640   LINE(ZX,ZY+40)   -STEP(100,50),PSET,0,B
  66. 1650   LINE(ZX+50,ZY+20)-STEP(  0,70),PSET,0
  67. 1660   LINE(14,401)-(626,419),PSET,0,BF,5
  68. 1670   IF URA THEN C0=7:C1=0:GOSUB *スイッチ
  69. 1680   SYMBOL(ZX+26,ZY+2) ,"実物大",1,1,7
  70. 1690   SYMBOL(ZX+5 ,ZY+22),"32dot" ,1,1,7
  71. 1700   SYMBOL(ZX+55,ZY+22),"16dot" ,1,1,7
  72. 1710   SYMBOL(16,402),"マウスカーソル編集プログラム  Version 2.55    Copyright (C) Ryoichi.Watanabe" ,1,1,7
  73. 1720   IF E_字数 THEN
  74. 1730     FOR D=0 TO 1
  75. 1740       FOR Y=0 TO D*16+15
  76. 1750         FOR X=0 TO D*16+15
  77. 1760         IF M(D,X,Y)<>2 THEN GOSUB *描く
  78. 1770     NEXT X,Y,D
  79. 1780   ELSE
  80. 1790     MOUSE 0       'マウス初期化
  81. 1800     MOUSE 3,0,INP(&H3B06):MOUSE 3,1,INP(&H3B06) 'マウス移動比率設定
  82. 1810     MOUSE 1,0,0,1 'マウス表示
  83. 1820     S=1
  84. 1830     D=0:GOSUB *クリア
  85. 1840     D=1:GOSUB *クリア:S=0
  86. 1850   ENDIF
  87. 1860   CALLM 0:COLOR 7
  88. 1870 '
  89. 1880 'メインルーチン
  90. 1890 *メイン
  91. 1900   K$="":WHILE NOT(MOUSE(2,0)) AND K$="":K$=INKEY$:WEND
  92. 1910   IF K$=CHR$(27) THEN *END 'esc
  93. 1920   X=MOUSE(0):Y=MOUSE(1)
  94. 1930   IF (X<320 AND Y<320) OR (349<X AND X<510 AND Y<160) THEN
  95. 1940     IF X<320 THEN D=1 ELSE D=0:X=X-350
  96. 1950     X=X\10:Y=Y\10
  97. 1960     IF M(D,X,Y)<>CL THEN M(D,X,Y)=CL:GOSUB *描く
  98. 1970   ELSE IF 13=<X AND X=<620 AND 400=<Y AND Y=<420 AND MOUSE(2,0) THEN
  99. 1980     URA=-1
  100. 1990     C0=0:C1=7:GOSUB *スイッチ
  101. 2000     WHILE 13=<MOUSE(0) AND MOUSE(0)=<620 AND                                          400=<MOUSE(1) AND MOUSE(1)<=420 AND MOUSE(2,0):WEND
  102. 2010     C0=7:C1=0:GOSUB *スイッチ
  103. 2020   ELSE IF ZY+40<Y AND Y<ZY+90 AND ZX<X THEN
  104. 2030     IF X<ZX+50 THEN
  105. 2040       GOSUB *GET_32
  106. 2050       MOUSE 6,0,PA,PD
  107. 2060     ELSE IF X<ZX+100 THEN
  108. 2070       GOSUB *GET_16
  109. 2080       MOUSE 2,A$,D$
  110. 2090     ENDIF
  111. 2100   ELSE IF X<EX OR EX+50<X OR Y<EY THEN
  112. 2110     GOTO *メイン
  113. 2120   ELSE IF Y<EY+19 THEN
  114. 2130     GOTO *END
  115. 2140   ELSE IF Y<EY+38 THEN
  116. 2150     GOSUB *GET_32
  117. 2160     GOSUB *ファイル選択
  118. 2170     FL$=E_文字$:ER=1
  119. 2180     IF D THEN
  120. 2190       OPEN "O",#1,FL$
  121. 2200       FOR I=0 TO 63
  122. 2210         PRINT#1,MKI$(PA(I));MKI$(PD(I));
  123. 2220       NEXT
  124. 2230       CLOSE #1
  125. 2240     ELSE
  126. 2250       GOSUB *GET_16
  127. 2260       OPEN"O",#1,FL$
  128. 2270       PRINT#1,A$;D$;
  129. 2280       CLOSE #1
  130. 2290     ENDIF
  131. 2300     GOTO *画面表示
  132. 2310   ELSE IF Y<EY+57 THEN
  133. 2320     GOSUB *ファイル選択:ER=2
  134. 2330     IF D THEN
  135. 2340       OPEN"I",#1,FL$
  136. 2350       FOR I=0 TO 63
  137. 2360         PA(I)=CVI(INPUT$(2,1))
  138. 2370         PD(I)=CVI(INPUT$(2,1))
  139. 2380       NEXT
  140. 2390       CLOSE #1
  141. 2400       'データ変換
  142. 2410       I=0
  143. 2420       FOR Y=0 TO 31
  144. 2430       FOR XX=0 TO 24 STEP 8
  145. 2440         A=PEEK(A&+I):D=PEEK(D&+I)
  146. 2450         I=I+1:W=&H100
  147. 2460         FOR X=0 TO 7
  148. 2470           W=W/2
  149. 2480           IF ((A OR D) AND W)=0      THEN M(1,XX+X,Y)=0 ELSE                           IF (A AND W)=0 AND D AND W THEN M(1,XX+X,Y)=1                                                           ELSE M(1,XX+X,Y)=2
  150. 2490       NEXT X,XX,Y
  151. 2500     ELSE
  152. 2510       OPEN"I",#1,FL$
  153. 2520       A$=INPUT$(64,1)
  154. 2530       CLOSE #1
  155. 2540       FOR Y=0 TO 15
  156. 2550         FOR I=0 TO 1
  157. 2560           A=ASC(MID$(A$,Y*2+I+ 1,1))
  158. 2570           D=ASC(MID$(A$,Y*2+I+33,1)):W=&H100
  159. 2580           FOR X=0 TO 7
  160. 2590             W=W/2
  161. 2600             IF ((A OR D) AND W)=0      THEN M(0,I*8+X,Y)=0 ELSE                          IF A AND W AND (D AND W)=0 THEN M(0,I*8+X,Y)=2                                                          ELSE M(0,I*8+X,Y)=1
  162. 2610       NEXT X,I,Y
  163. 2620     ENDIF
  164. 2630     GOTO *画面表示
  165. 2640   ELSE IF Y<EY+95 THEN
  166. 2650     IF Y<EY+76 THEN D=0 ELSE D=1
  167. 2660     GOSUB *クリア:GOTO *メイン
  168. 2670   ELSE IF Y<EY+152 THEN
  169. 2680     IF Y<EY+114 THEN CC=0 ELSE IF Y<EY+133 THEN CC=1 ELSE CC=2
  170. 2690     IF CL<>CC THEN C0=0:GOSUB *C_C:CL=CC:C0=1:GOSUB *C_C
  171. 2700   ENDIF
  172. 2710   GOTO *メイン
  173. 2720 '
  174. 2730 '
  175. 2740 *クリア
  176. 2750   FOR Y=0 TO D*16+15
  177. 2760     FOR X=0 TO D*16+15
  178. 2770       IF S=1 THEN M(D,X,Y)=2
  179. 2780       IF M(D,X,Y)<>MC(D,X,Y) THEN M(D,X,Y)=MC(D,X,Y):GOSUB *描く
  180. 2790   NEXT X,Y
  181. 2800   RETURN
  182. 2810 *C_C   'カラーカーソル表示
  183. 2820   IF CL=0 THEN Y0=EY+96 ELSE IF CL=1 THEN Y0=EY+115 ELSE Y0=EY+134
  184. 2830   IF C0 THEN
  185. 2840     SYMBOL(EX-17,Y0),"→",1,1,2
  186. 2850   ELSE
  187. 2860     LINE(EX-17,Y0)-STEP(16,16),PSET,,BF
  188. 2870   ENDIF
  189. 2880   RETURN
  190. 2890 '
  191. 2900 *描く
  192. 2910   IF D=0 THEN X2=350:X3=ZX+67:Y3=ZY+57 ELSE X2=0:X3=ZX+9:Y3=ZY+49
  193. 2920   IF M(D,X,Y)=0 THEN C=0 ELSE IF M(D,X,Y)=1 THEN C=7 ELSE C=4
  194. 2930   LINE(X2+X*10+1,Y*10+1)-STEP(8,8),PSET,C,BF,C
  195. 2940   IF C=4 THEN C=1
  196. 2950   PSET(X3+X,Y3+Y),C
  197. 2960   RETURN
  198. 2970 '
  199. 2980 *GET_16    'ａｎｄパターンとドットパターンを作成する
  200. 2990   A$="":D$=""
  201. 3000   FOR Y=0 TO 15:FOR I=0 TO 8 STEP 8
  202. 3010     W=128:A=0:D=0
  203. 3020     FOR X=0 TO 7
  204. 3030       IF M(0,X+I,Y)=2 THEN A=(A OR Z):A(0,X+I,Y)=1 ELSE A(0,X+I,Y)=0
  205. 3040       IF M(0,X+I,Y)=1 THEN D=(D OR Z):A(1,X+I,Y)=1 ELSE A(1,X+I,Y)=0
  206. 3050       W=W/2
  207. 3060     NEXT
  208. 3070     A$=A$+CHR$(A)
  209. 3080     D$=D$+CHR$(D)
  210. 3090   NEXT I,Y
  211. 3100   RETURN
  212. 3110 *GET_32
  213. 3120   I=0
  214. 3130   FOR Y=0 TO 31
  215. 3140   FOR XX=0 TO 24 STEP 8
  216. 3150     W=&H100:A=0:D=0
  217. 3160     FOR X=0 TO 7
  218. 3170       W=W/2
  219. 3180       IF M(1,XX+X,Y)=1 THEN D=D OR W ELSE                                          IF M(1,XX+X,Y)=2 THEN A=A OR W
  220. 3190     NEXT
  221. 3200     POKE A&+I,A,1:POKE D&+I,D,1
  222. 3210     I=I+1
  223. 3220   NEXT XX,Y
  224. 3230   RETURN
  225. 3240 '
  226. 3250 *スイッチ'(13,400)-(627,420)
  227. 3260   LINE( 13,400)-(627,401),PSET,C0,BF,C0
  228. 3270   LINE( 13,402)-( 14,418),PSET,C0,BF,C0
  229. 3280   LINE( 15,419)-(627,420),PSET,C1,BF,C1
  230. 3290   LINE(626,402)-(627,418),PSET,C1,BF,C1
  231. 3300   RETURN
  232. 3310 '
  233. 3320 *ファイル選択
  234. 3330   E_字数=77:E_X=1:E_CR0=0:E_CR1=2
  235. 3340   COLOR 7,0:CLS
  236. 3350   PRINT"どっちを";
  237. 3360   IF Y<EY+38 THEN PRINT"セーブしますか" ELSE PRINT"ロードしますか"
  238. 3370   PRINT"16×16ドット・32×32ドット"
  239. 3380   PRINT"マウスで左クリック  右クリックで取消"
  240. 3390 *二択
  241. 3400   XX=MOUSE(0):YY=MOUSE(1)
  242. 3410   IF     MOUSE(2,1)  THEN RETURN *画面表示 '右クリック
  243. 3420   IF NOT(MOUSE(2,0)) THEN *二択
  244. 3430     IF            XX< 97 AND 18<YY AND YY<36 THEN D=0 ELSE                       IF 111<XX AND XX<209 AND 18<YY AND YY<36 THEN D=1 ELSE *二択
  245. 3440   IF D       THEN PRINT"32×32ドットを"; ELSE PRINT"16×16ドットを";
  246. 3450   IF Y<EY+38 THEN PRINT"セーブします。"  ELSE PRINT"ロードします。"
  247. 3460   PRINT"ファイル名を入力してください。"
  248. 3470   ON ERROR GOTO *ERR
  249. 3480  *入力
  250. 3490   COLOR 7:E_Y=CSRLIN:PRINT">":IF E_Y=>CSRLIN THEN E_Y=E_Y-1
  251. 3500   E_文字$="":取消=0:GOSUB *文字編集
  252. 3510   IF E_文字$="" OR 取消 THEN RETURN *画面表示
  253. 3520   FL$=E_文字$:L$=LEFT$(E_文字$,3)
  254. 3530   IF L$<>"DIR" AND L$<>"dir" THEN RETURN
  255. 3540     FL$=MID$(E_文字$,4)
  256. 3550     WHILE LEFT$(FL$,1)=CHR$(32)
  257. 3560       FL$=MID$(FL$,2)
  258. 3570     WEND
  259. 3580     WHILE KRIGHT$(FL$,1)=CHR$(32)
  260. 3590       FL$=KLEFT$(FL$,KLEN(FL$)-1)
  261. 3600     WEND
  262. 3610     ER=0:FILES FL$
  263. 3620     GOTO *入力
  264. 3630 *ERR
  265. 3640   BEEP
  266. 3650   IF ER=0 THEN PRINT"ファイルが見つかりません。":RESUME *入力
  267. 3660   IF ER=1 THEN PRINT"セーブに失敗しました。"                                           ELSE PRINT"ロードに失敗しました。"
  268. 3670   CALLM 0:WHILE INKEY$="":WEND
  269. 3680   ER=0:RESUME *画面表示
  270. 3690 '
  271. 3700 *END
  272. 3710   WHILE MOUSE(2,0):WEND
  273. 3720   COLOR 7,0:CLS
  274. 3730   MOUSE 1,,,0
  275. 3740   GOSUB *GET_16
  276. 3750   FOR X1=0 TO 1
  277. 3760     FOR Y=0 TO 15
  278. 3770       LOCATE X1*40,Y
  279. 3780       FOR X=0 TO 14
  280. 3790         PRINT RIGHT$(STR$(A(X1,X,Y)),1);",";
  281. 3800       NEXT
  282. 3810       PRINT RIGHT$(STR$(A(X1,X,Y)),1);
  283. 3820       IF X1=0 THEN M$=A$ ELSE M$=D$
  284. 3830       O$=HEX$(ASC(MID$(M$,1+Y*2,1)))
  285. 3840       IF LEN(O$)=1 THEN O$="0"+O$
  286. 3850       P$=HEX$(ASC(MID$(M$,2+Y*2,1)))
  287. 3860       IF LEN(P$)=1 THEN P$="0"+P$
  288. 3870       PRINT "  ";O$;" ";P$
  289. 3880     NEXT
  290. 3890   NEXT
  291. 3900   PRINT SPC(13);"ａｎｄパターン";SPC(26);"ドットパターン"
  292. 3910   WHILE INKEY$<>"":WEND
  293. 3920   WHILE INKEY$="" AND NOT(MOUSE(2,0)):WEND
  294. 3930 *終了:MOUSE 5:END
  295. 3940 '
  296. 3950 '
  297. 3960 '
  298. 3970 '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
  299. 3980 '★      　 　     プログラム開発支援シリーズ第５弾　　　　　　　　★
  300. 3990 '★            文字列編集サブルーチン    TYPE A  v1.01             ★
  301. 4000 '★                            　 94年８月19日（金）  (C)渡辺 良一 ★
  302. 4010 '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
  303. 4020 '
  304. 4030 '変数紹介（先頭の『E_』は省略）
  305. 4040 '  文字$ ……… 編集する文字列
  306. 4050 '  X,Y   ……… 文字を表示する文字座標
  307. 4060 '  字数  ……… 編集する文字の最大の長さ(半角計算)
  308. 4070 '  CR0   ……… 背景色
  309. 4080 '  CR1   ……… カーソルの色
  310. 4090 '  CR    ……… カーソル移動時に使用
  311. 4100 '  M     ……… 文字入力時に使用
  312. 4110 '  XX    ……… カーソルを表示するＸ文字座標
  313. 4120 '  C     ……… カーソルの文字列中の位置(文字数で)
  314. 4130 '  I,I2  ……… カーソルを移動させる文字座標
  315. 4140 '  K$,K  ……… 入力された文字とそのキャラクタコード
  316. 4150 '
  317. 4160 *文字編集
  318. 4170   CALLM 0
  319. 4180   GOSUB *E_文字表示
  320. 4190   E_XX=LEN(E_文字$):E_C=KLEN(E_文字$)
  321. 4200   E_CR=E_CR1:GOSUB *E_書く
  322. 4210 *E_INKEY
  323. 4220   E_K$=INKEY$
  324. 4230   IF MOUSE(2,1) THEN 取消=1:RETURN '右クリック
  325. 4240   IF E_K$="" THEN *E_INKEY
  326. 4250   E_K=ASC(E_K$)
  327. 4260   '  ↓実行キー
  328. 4270   IF E_K=13 THEN GOSUB *E_消す       :RETURN
  329. 4280   IF E_K=24 THEN GOSUB *E_消す:取消=1:RETURN
  330. 4290   '  ↑取消キー
  331. 4300   IF E_K=5 AND E_XX<LEN(E_文字$) THEN *E_一括削除
  332. 4310   IF E_K=8 AND E_C >0            THEN *E_後退
  333. 4320   IF E_K=127 THEN IF E_XX<LEN(E_文字$) THEN *E_削除 ELSE *E_INKEY
  334. 4330   IF E_K=28 AND E_XX<LEN(E_文字$) THEN E_I= 1:GOTO *E_左右移動 '右
  335. 4340   IF E_K=29 AND E_C >0            THEN E_I=-1:GOTO *E_左右移動 '左
  336. 4350   IF E_K<32 THEN *E_INKEY    '↓日本語文字なら次も入力する
  337. 4360   IF (127<E_K AND E_K<160) OR 223<E_K THEN E_K$=E_K$+INKEY$
  338. 4370   '**** 文字入力 *********
  339. 4380   E_M=LEN(E_文字$+E_K$)
  340. 4390   IF E_M>E_字数 THEN BEEP:CALLM 0:GOTO *E_INKEY
  341. 4400   E_文字$=KLEFT$(E_文字$,E_C)+E_K$+KMID$(E_文字$,E_C+1)
  342. 4410   E_I=1:E_I2=LEN(E_K$):GOSUB *E_文字表示:GOTO *E_移動
  343. 4420 '
  344. 4430 *E_一括削除
  345. 4440   E_文字$=KLEFT$(E_文字$,E_C)+STRING$(LEN(E_文字$)-E_C,32)
  346. 4450   GOSUB *E_文字表示
  347. 4460   E_文字$=KLEFT$(E_文字$,E_C)
  348. 4470   GOTO *E_INKEY
  349. 4480 *E_後退
  350. 4490   IF KTYPE(E_文字$,E_C) THEN E_I2=-2 ELSE E_I2=-1
  351. 4500   E_文字$=KLEFT$(E_文字$,E_C-1)+KMID$(E_文字$,E_C+1)
  352. 4510   GOSUB *E_文字表示:E_I=-1:GOTO *E_移動
  353. 4520 *E_削除
  354. 4530   E_文字$=KLEFT$(E_文字$,E_C)+KMID$(E_文字$,E_C+2)
  355. 4540   GOSUB *E_文字表示
  356. 4550   GOTO *E_INKEY
  357. 4560 *E_左右移動       '↓右移動なら+1 ↓日本語文字ならば
  358. 4570   IF KTYPE(E_文字$,29-E_K +E_C) THEN E_I2=E_I*2 ELSE E_I2=E_I
  359. 4580 '************************
  360. 4590 *E_移動
  361. 4600   E_C=E_C+E_I
  362. 4610   GOSUB *E_消す
  363. 4620   E_CR=E_CR1:E_XX=E_XX+E_I2
  364. 4630   GOSUB *E_表示
  365. 4640   GOTO *E_INKEY
  366. 4650 *E_消す:E_CR=E_CR0:GOSUB *E_書く:RETURN 'カーソル消す
  367. 4660 *E_表示:E_CR=E_CR1:GOSUB *E_書く:RETURN 'カーソル表示
  368. 4670 *E_書く:LINE((E_X+E_XX)*8,E_Y*19)-STEP(1,15),PSET,E_CR,B:RETURN
  369. 4680 *E_文字表示:LOCATE E_X,E_Y:PRINT E_文字$;"  ":RETURN
  370. 4690 '
  371. 4700 '
  372. 4710 DATA 終わり,8,セーブ,8,ロード,8,ｸﾘｱ 16,8,ｸﾘｱ 32,8
  373. 4720 DATA " 黒",0," 白",7,透明,4
  374.